perm filename FPREPA.SAI[8,ALS] blob
sn#044822 filedate 1973-05-28 generic text, type T, neo UTF8
00010 ENTRY PREPARE;
00020 BEGIN "XPREPARE"
00030
00040 DEFINE ⊂="COMMENT"; ⊂ This package contains all of the procedures
00050 that are used to process the input to obtain data in a form suitable
00060 for use in the signature tables which, in turn are processed by a
00070 separate MAC package SIG.;
00080
00100
00110 EXTERNAL REAL ARRAY A,B,C[0:256];
00120 EXTERNAL INTEGER ARRAY INRAW,INDAT,INSUB,INDIV,INCNT,INNAM[0:24];
00125 DEFINE LISSIZ="760";
00127 EXTERNAL INTEGER ARRAY LIST[0:LISSIZ];
00130 EXTERNAL INTEGER ARRAY SUMDAT[0:1536];
00140 EXTERNAL INTEGER M,N,P;
00150 EXTERNAL INTEGER MINK,MINLOC,MAXK,MAXLOC,SEGC,SEGMRK,STEPS,INFLAG;
00155 INTEGER ARRAY DELDAT[0:24];
00160
00170 PROCEDURE INSET;
00180 BEGIN
00190 IF INRAW[P]<INSUB[P] THEN INSUB[P]←INRAW[P];
00200 IF INDIV[P]<INRAW[P] THEN INDIV[P]←INRAW[P];
00220 ⊂ INCNT[P]←INCNT[P]+1;
00270 END "INSET";
00280
00290
00300 REAL SX;INTEGER NC; ⊂ **** SX GIVES FREQ INCREMENT PER FFT POINT ;
00310 ⊂ **** NC IS THE NO OF FFT POINTS;
00320 DEFINE SPEC="C" ; ⊂ **** ARRAY FOR FFT;
00330
00340
00350 ⊂ **** GLOBALS FOR PARAEX ;
00360 INTEGER NP,NZ,FP1,FP2,FZ ; REAL NPA,NZA,FP1A,FP2A,FZA, LPE,HPE,AVE ;
00370 INTEGER ARRAY FF[1:5] ; REAL ARRAY AMP[1:5] ;
00380 REAL PROCEDURE BAL(INTEGER M);
00381 BEGIN REAL XX;
00382 XX←M-((SPEC[M-1]-SPEC[M+1])/(SPEC[M-1]+SPEC[M]+SPEC[M+1]));
00383 RETURN(XX);
00384 END "BAL";
00385
00386 INTEGER PROCEDURE ABS(INTEGER M); BEGIN IF M<0 THEN M←-M; RETURN(M) END ;
00387
00388
00389
00390
00400 ⊂ **** GLOBAL PARAMETER RANGES. SET IN "MAIN" PROGRAMME;
00410 EXTERNAL INTEGER I1L,I1H,I2L,I2H,I3L,I3H, INL,INH,NZRNG, FP1L,FP1H,FP2L,FP2H,
00420 ILPB,ILPC, IHPB,IHPC ;
00430 ⊂ THE PARA LIMITS ARE (DOUBLE CHECK) F1=200/800 F2=700/2050 F3=2000/3200
00431 NP=800/1500 NZRNG=NP+/-500 ?
00432 FP1=1800/3200 FP2=3200/5000 LPE=300/450 HPE=2500/3000 ;
00433 ⊂ **** I2H CHANGED FROM 28 TO 26 ESCAPE HI AMP F3 ;
00434 ⊂ SX←SF/(2.*NC),I1L←200./SX,I1H←800./SX+.5,I2L←700./SX,I2H←2050./SX+.5;
00435 ⊂ I3L←1950./SX, I3H←3250./SX+.5;
00436 ⊂ INL←800./SX, INH←1500./SX+.5, NZRNG←500./SX+.5;
00437 ⊂ FP1L←1800./SX, FP1H←3200./SX, FP2L←3200./SX+.5, FP2H←5000./SX+.5;
00438 ⊂ ILPB←300./SX, ILPC←450./SX, IHPC←2500./SX, IHPB←3000./SX;
00440
00441 PROCEDURE F2DECI;
00442 ⊂ **** DECIDE IF F2 CLOSE TO F1;
00443 ⊂ ********* FIX TH & 12.(DBS) ONLY AFTER EXING I'S U'S AND A'S;
00444
00445 BEGIN
00446 REAL SUML,SUMH,TH; INTEGER I;
00447
00448 TH←6.0 ; SUML←0.;
00449 FOR I←I2L STEP 1 UNTIL I1H DO SUML←SUML+SPEC[I];
00450 SUML←SUML/(I1H-I2L+1.0);
00451
00452 SUMH←0.; FOR I←I3L STEP 1 UNTIL I2H DO SUMH←SUMH+SPEC[I];
00453 SUMH←SUMH/(I2H-I3L+1.0);
00454
00455 IF SUML>SUMH+TH+12.0 THEN FF[2]←FF[1]+1 ;
00456 ⊂ OUTSTR(NL&"SUML="&CVF(SUML)&"SUMH="&CVF(SUMH));
00457 END "F2DECI";
00458
00459
00460
00461 INTEGER PROCEDURE PEAK(INTEGER I1,I2);
00462 ⊂ **** THIS PROCEDURE LOOKS AT A SECTION BETWEEN I1 & I2 AND LOCATES
00463 A PROPER PEAK;
00464 BEGIN
00465 LABEL L1,L2; REAL YMX; INTEGER I,IX;
00466 YMX←-1000.0;
00467 L1: FOR I←I1 STEP 1 UNTIL I2 DO
00468 IF YMX<SPEC[I] THEN BEGIN YMX←SPEC[I]; IX←I END;
00469 IF IX=I1 THEN BEGIN
00470 WHILE YMX>SPEC[I1+1] DO
00471 BEGIN I1←I1+1; IF I1=I2 THEN GOTO L2; YMX←SPEC[I1] END;
00472 GOTO L1 END;
00473 IF IX=I2 THEN BEGIN
00474 WHILE YMX>SPEC[I2-1] DO
00475 BEGIN I2←I2-1; IF I2=I1 THEN GOTO L2;
00476 YMX←SPEC[I2] END;
00477 GO TO L1; END;
00478 RETURN(IX);
00479 ⊂ OUTSTR(NL&NL&"NO PROPER PEAKS IN SAMPLE NO="&CVS(N)); L2 : RETURN(IX);
00480 END "PEAK";
00490 INTEGER I,J;
00500 PROCEDURE FORMANTS;
00510 ⊂ **** I1L,I1H,I2L,I2H,I3L,I3H DEFINE THE RANGES RES FORMANTS;
00520 ⊂ **** SPEC[FFT,TIME]=SPECTRUM(GLOBAL);
00530 ⊂ **** INTEGER FF[5]& REAL AMP[5] (GLOBAL);
00540 ⊂ **** LOWER F2H LIMIT TO AVOID HIGH ENERGY F3, CATCH PROPER F2 BY AMP COMPARISON;
00550
00560 BEGIN
00570 IF INFLAG=1 THEN BEGIN
00580 INNAM[P]←LIST[P]←CVSIX("F1"); INNAM[P+1]←LIST[P+1]←CVSIX("F2"); P←P+2;
00590 INNAM[P]←LIST[P]←CVSIX("F3"); INNAM[P+1]←LIST[P+1]←CVSIX("A1"); P←P+2;
00600 INNAM[P]←LIST[P]←CVSIX("A2"); INNAM[P+1]←LIST[P+1]←CVSIX("A3"); P←P+2; END ELSE BEGIN
00610 INTEGER I;⊂ EXTERNAL INTEGER PROCEDURE PEAK(INTEGER I1,I2);
00620 ⊂ EXTERNAL PROCEDURE F2DECI;
00630 FF[1]←PEAK(I1L,I1H);
00640 FF[2]←PEAK(I2L,I2H);
00650 FF[3]←PEAK(I3L,I3H);
00660 IF FF[1]=FF[2] THEN BEGIN FF[2]←PEAK(I1H,I2H); F2DECI END ;
00670 ⊂ **** F2DECI ON SPECTRAL BALANCE ;
00680 IF SPEC[FF[2]]+6.0<SPEC[FF[3]] THEN BEGIN FF[2]←FF[3] ;
00690 FF[3]←PEAK(FF[3],I3H) END ;
00700
00710 IF FF[2]=FF[3] THEN FF[3]←PEAK(FF[3],I3H) ;
00720 ⊂ FF[4]←PEAK(I1H,I3L);
00730 ⊂ FF[5]←PEAK(I3H,I3H+10);
00740 FOR I←1 STEP 1 UNTIL 3 DO
00750 AMP[I]←SPEC[FF[I]];
00780 INDAT[P]←(BAL(FF[1])-1.5)*63./7.;⊂ INRAW[P]←FF[1];⊂ INSET; P←P+1;
00790 INDAT[P]←(BAL(FF[2])-I2L)*(63./20);⊂ INRAW[P]←FF[2];⊂ INSET; P←P+1;
00800 INDAT[P]←(BAL(FF[3])-25)*(63./16.);⊂ 26 16 INRAW[P]←FF[3];⊂ INSET; P←P+1;
00810 INDAT[P]←(AMP[1]-10.)*(63./18.6); ⊂ INRAW[P]←AMP[1] ;⊂ INSET; P←P+1;
00820 INDAT[P]←(AMP[2]-10)*(63./16.5);⊂ 30 16 INRAW[P]←AMP[2];⊂ INSET; P←P+1;
00830 INDAT[P]←(AMP[3]-10.)*(63./16.5);⊂ 25 16 INRAW[P]←AMP[3];⊂ INSET; P←P+1;
00840
00850
01000 END;
01010 END "FORMANTS";
01210
01220
01230
01240 PROCEDURE FRINAS ; BEGIN
01250 IF INFLAG=1 THEN BEGIN
01260 INNAM[P]←LIST[P]←CVSIX("FP1"); INNAM[P+1]←LIST[P+1]←CVSIX("FP1A"); P←P+2;
01270 INNAM[P]←LIST[P]←CVSIX("FP2"); INNAM[P+1]←LIST[P+1]←CVSIX("FP2A"); P←P+2;
01275 INNAM[P]←LIST[P]←CVSIX("FZ"); INNAM[P+1]←LIST[P+1]←CVSIX("FZA"); P←P+2;
01280 INNAM[P]←LIST[P]←CVSIX("NP"); INNAM[P+1]←LIST[P+1]←CVSIX("NPA"); P←P+2;
01290 INNAM[P]←LIST[P]←CVSIX("NZ"); INNAM[P+1]←LIST[P+1]←CVSIX("NZA"); P←P+2; END ELSE BEGIN
01295 ⊂ EXTERNAL INTEGER PROCEDURE PEAK(INTEGER I1,I2);
01300 NP←PEAK(INL,INH); FP1←PEAK(FP1L,FP1H); FP2←PEAK(FP2L,FP2H);
01305 FP1A←SPEC[FP1]; FP2A←SPEC[FP2]; NPA←SPEC[NP];
01310 BEGIN "ZEROS" REAL XNZ; INTEGER STP,JX,J;
01320 STP←(NZRNG)/ABS(NZRNG); XNZ←10000.;
01330 FOR J←NP STEP STP UNTIL NP+NZRNG DO
01340 IF XNZ>SPEC[J] THEN BEGIN XNZ←SPEC[J]; JX←J END;
01350 NZ←JX; NZA←SPEC[NZ]; XNZ←10000.;
01360 FOR J←FP1 STEP 1 UNTIL FP2 DO
01370 IF XNZ>SPEC[J] THEN BEGIN XNZ←SPEC[J]; JX←J END;
01380 FZ←JX; FZA←SPEC[FZ];
01390 END "ZEROS";
01391 INDAT[P]←(BAL(FP1)-24)*(63./14.2);⊂ INRAW[P]←FP1;⊂ INSET; P←P+1;
01393 INDAT[P]←(FP1A-10)*(63./16.5);⊂ 24 16 INRAW[P]←FP1A;⊂ INSET; P←P+1;
01395 INDAT[P]←(BAL(FP2)-39.)*(63./18.5);⊂ 42 18 INRAW[P]←FP2;⊂ INSET; P←P+1;
01397 INDAT[P]←(FP2A-21.)*(63./19.);⊂ INRAW[P]←FP2A;⊂ INSET; P←P+1;
01399 INDAT[P]←(FZ-31.5)*(63./16.2);⊂ 32 16.2 INRAW[P]←FZ;⊂ INSET; P←P+1;
01401 INDAT[P]←(FZA-10.)*(63./19.) ;⊂ 12 21 INRAW[P]←FZA;⊂ INSET; P←P+1;
01403 INDAT[P]←(BAL(NP)-INL)*(63./9.);⊂ INRAW[P]←NP;⊂ INSET; P←P+1;
01405 INDAT[P]←(NPA-10)*(63./19.5);⊂ 28 20 INRAW[P]←NPA;⊂ INSET; P←P+1;
01407 INDAT[P]←(NZ-14)*(63./9.2);⊂ INRAW[P]←NZ;⊂ INSET; P←P+1;
01409 INDAT[P]←(NZA-10.)*(63./18.);⊂ 18 21 INRAW[P]←NZA;⊂ INSET; P←P+1;
01411
01413
01419 END;
01424 END "FRINAS";
01430 PROCEDURE SEGPAR;
01440 BEGIN "SEGPAR"
01450 IF INFLAG=1 THEN BEGIN
01460 INNAM[P]←LIST[P]←CVSIX("LPE"); INNAM[P+1]←LIST[P+1]←CVSIX("AVE"); P←P+2;
01470 INNAM[P]←LIST[P]←CVSIX("HPE"); P←P+1; END ELSE BEGIN
01480 INTEGER J,K;
01490 ⊂ ***** COMPUTE LOW-PASS POWER ;
01500 LPE←0.0;
01510 FOR J←1 STEP 1 UNTIL ILPB DO
01520 LPE←LPE+SPEC[J];
01530
01540 K←ILPC-ILPB;
01550 FOR J←ILPB+1 STEP 1 UNTIL ILPC DO LPE←LPE+(SPEC[J]*(ILPC-J)/K);
01560 LPE←LPE/ILPC;
01570
01580 ⊂ ***** COMPUTE HIGH-PASS POWER;
01590
01600 HPE←0.0; K←IHPB-IHPC;
01610 FOR J←IHPC STEP 1 UNTIL IHPB-1 DO HPE←HPE+(SPEC[J]*(J-IHPC)/K);
01620 FOR J←IHPB STEP 1 UNTIL NC DO HPE←HPE+SPEC[J];
01630 HPE←HPE/(NC-IHPC);
01640
01650 ⊂ ***** COMPUTE AVERAGE POWER;
01660 AVE←0.0;
01670 FOR J←0 STEP 1 UNTIL NC DO AVE←AVE+SPEC[J];
01680 AVE←AVE/NC;
01681 INDAT[P]←(LPE-10.)*(63./10.5);⊂ 23 12 INRAW[P]←LPE;⊂ INSET; P←P+1;
01686 INDAT[P]←(AVE-1.)*(63./6.7);⊂ 9 7.5 INRAW[P]←AVE;⊂ INSET; P←P+1;
01688 INDAT[P]←(HPE-6)*(63./6.2);⊂ INRAW[P]←HPE;⊂ INSET; P←P+1;
01690 END;
01700 END "SEGPAR";
01710
00020
00030 INTERNAL PROCEDURE PREPARE;
00040 BEGIN
00200
00250 P←0; ⊂ Each procedure puts results in sequential locations in INRAW[P]
00300 and calls INSET which computes corresponding values INDAT[P] and updates P;
00350 P←0; NC←N;
00450 FORMANTS;
00500 FRINAS;
00550 SEGPAR;
00855 END;
00900 END "XPREPARE";
00950